home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
tool_inc.zip
/
LOCFILE.INC
< prev
next >
Wrap
Text File
|
1989-06-02
|
3KB
|
123 lines
(*
* Copyright 1987, 1989 Samuel H. Smith; All rights reserved
*
* This is a component of the ProDoor System.
* Do not distribute modified versions without my permission.
* Do not remove or alter this notice or any other copyright notice.
* If you use this in your own program you must distribute source code.
* Do not use any of this in a commercial product.
*
*)
(*
* get the value of an environment variable
*
*)
type
gestring = string[255];
function get_environment_var(id: gestring): gestring;
var
envseg: integer;
i: integer;
env: gestring;
begin
envseg := memw[PrefixSeg:$2c];
i := 0;
repeat
env := '';
while mem[envseg:i] <> 0 do
begin
env := env + chr(mem[envseg:i]);
i := i + 1;
end;
if copy(env,1,length(id)) = id then
begin
get_environment_var := copy(env,length(id)+1,255);
exit;
end;
i := i + 1;
until mem[envseg:i] = 0;
(* not found *)
get_environment_var := '';
end;
(*
* locate a file with search rules from specified environment variable.
* returns the full pathname of the located file.
* returns only the original name if not found.
*
*)
function locate_file_env(name: gestring;
environ: gestring): gestring;
var
paths: gestring;
dir: gestring;
i: integer;
fd: file;
begin
(* get the paths and start searching them. arrange for current directory
to be scanned first. add trailing ; to handle special case for last path *)
paths := environ + ';';
dir := '';
for i := 1 to length(paths) do
begin
(* if a full directory has been collected, then try this path *)
if (paths[i] = ';') or (i = length(paths)) then
begin
if (length(dir) > 1) and (dir[length(dir)] <> '\') then
dir := dir + '\';
{$I-}
assign(fd,dir + name);
reset(fd);
{$I+}
if ioresult = 0 then
{! 7. IOResu^lt now returns different values corresponding to DOS error codes.}
begin
close(fd);
locate_file_env := dir + name;
exit;
end;
dir := '';
end
else
dir := dir + paths[i];
end;
(* couldn't find it. return the original name *)
locate_file_env := name;
end;
(*
* locate a file. search PATH= paths if needed. returns
* the full pathname of the located file.
* returns only the original name if not found.
*
*)
function locate_file(name: gestring): gestring;
begin
locate_file := locate_file_env(name,';' + get_environment_var('PATH='));
end;